home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / turbovis / tvtoys04.zip / COLORBOX.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-15  |  9KB  |  262 lines
  1. (***************************************************************************
  2.   ColorBox unit
  3.   Color selection dialog with instant updates and color propagation
  4.   PJB December 6, 1993, Internet mail to d91-pbr@nada.kth.se
  5.   Copyright PJB 1993, All Rights Reserved.
  6.   Free source, use at your own risk.
  7.   If modified, please state so if you pass this around.
  8.  
  9.   Color propagation is the FAST way to change the color scheme, it
  10.   maintains the same background color for a number of objects in windows
  11.   and dialogs. It is used by default.
  12.  
  13.   The WindowColorItems and the RegisterColorSel are redefinitions of the
  14.   ColorSel one, so you have to put this unit after ColorSel in the uses
  15.   list or use qualified names.
  16.  
  17. ***************************************************************************)
  18. unit ColorBox;
  19.  
  20. interface
  21.  
  22.   uses
  23.     App, ColorSel, Dialogs, Drivers, Memory, Objects, Views,
  24.     toyPrefs, TVUtils;
  25.  
  26.   type
  27.     PColorBox = ^TColorBox;
  28.     TColorBox =
  29.       object (TColorDialog)
  30.         OldPal      : TPalette;
  31.         Propagation : PCheckBoxes;
  32.         constructor Init(AGroups: PColorGroup);
  33.         procedure HandleEvent(var Event:TEvent); virtual;
  34.         procedure Propagate(Start:Integer);
  35.       end;
  36.  
  37.   const
  38.     (* Dangerous(?) redefinitions for improved WindowColorItems *)
  39.     wpBlueWindow = 8;
  40.     wpCyanWindow = 16;
  41.     wpGrayWindow = 24;
  42.     wpHelpWindow = 128;
  43.  
  44.   (* Reusable redefinition *)
  45.   function WindowColorItems(Offset:Word; const Next:PColorItem):PColorItem;
  46.   function HelpColorItems(Next:PColorGroup):PColorGroup;
  47.  
  48.   procedure RegisterColorSel;
  49.  
  50.  
  51. (***************************************************************************
  52. ***************************************************************************)
  53. implementation
  54.  
  55.  
  56.   (*******************************************************************
  57.     Improved to handle HelpFile as well
  58.   *******************************************************************)
  59.   function WindowColorItems(Offset:Word; const Next:PColorItem):PColorItem;
  60.   begin
  61.     WindowColorItems :=
  62.       ColorItem('Frame passive',     Offset + 0,
  63.       ColorItem('Frame active',      Offset + 1,
  64.       ColorItem('Frame icons',       Offset + 2,
  65.       ColorItem('Scroll bar page',   Offset + 3,
  66.       ColorItem('Scroll bar icons',  Offset + 4,
  67.       ColorItem('Normal text',       Offset + 5,
  68.       Next))))));
  69.   end;
  70.  
  71.  
  72.   (*******************************************************************
  73.     Help window color group
  74.   *******************************************************************)
  75.   function HelpColorItems(Next:PColorGroup):PColorGroup;
  76.   begin
  77.     HelpColorItems:=ColorGroup('Help',
  78.       WindowColorItems(wpHelpWindow,
  79.         ColorItem('Keyword', 134,
  80.         ColorItem('Selected', 135,
  81.         Nil))),
  82.       Next);
  83.   end;
  84.  
  85.  
  86. (***************************************************************************
  87. ***************************************************************************)
  88.  
  89.   (*******************************************************************
  90.     Background color links
  91.   *******************************************************************)
  92.   const
  93.     A = 32;
  94.     B = 64;
  95.     C = 96;
  96.  
  97.     Links : array [1..135] of Byte = (
  98.       1,                         (* Background 1 *)
  99.       3,4,2,7,6,5,               (* Menu and status line 2-7 *)
  100.       9,10,8,11,12,13,14,15,     (* Blue window 8-15 *)
  101.       17,18,16,19,20,21,22,23,   (* Cyan window 16-23 *)
  102.       25,26,24,27,28,29,30,31,   (* Gray window 24-31 *)
  103.  
  104.       (* Gray dialog *)
  105.       A+1,A+2,A+5,               (* Frame 1-3 *)
  106.       A+3,A+4,                   (* Scrollbar 4-5 *)
  107.       A+6,                       (* Static text 6 *)
  108.       A+7,A+8,A+14,              (* Label 7-9 *)
  109.       A+10,A+11,A+13,A+12,A+9,   (* Buttons 10-14 *)
  110.       A+22,                      (* Button shadow 15 *)
  111.       A+16,A+17,A+15,            (* Cluster 16-18 *)
  112.       A+18,A+19,A+20,            (* Input line 19-21 *)
  113.       A+21,A+0,A+23,A+24,        (* History 22-25 *)
  114.       A+27,A+26,A+28,A+25,       (* List viewer 26-29 *)
  115.       A+29,A+30,A+31,            (* Info pane 30, reserved 31-32 *)
  116.  
  117.       (* Blue dialog *)
  118.       B+1,B+2,B+5,               (* Frame 1-3 *)
  119.       B+3,B+4,                   (* Scrollbar 4-5 *)
  120.       B+6,                       (* Static text 6 *)
  121.       B+7,B+8,B+14,              (* Label 7-9 *)
  122.       B+10,B+11,B+13,B+12,B+9,   (* Buttons 10-14 *)
  123.       B+22,                      (* Button shadow 15 *)
  124.       B+16,B+17,B+15,            (* Cluster 16-18 *)
  125.       B+18,B+19,B+20,            (* Input line 19-21 *)
  126.       B+21,B+0,B+23,B+24,        (* History 22-25 *)
  127.       B+27,B+26,B+28,B+25,       (* List viewer 26-29 *)
  128.       B+29,B+30,B+31,            (* Info pane 30, reserved 31-32 *)
  129.  
  130.       (* Cyan dialog *)
  131.       C+1,C+2,C+5,               (* Frame 1-3 *)
  132.       C+3,C+4,                   (* Scrollbar 4-5 *)
  133.       C+6,                       (* Static text 6 *)
  134.       C+7,C+8,C+14,              (* Label 7-9 *)
  135.       C+10,C+11,C+13,C+12,C+9,   (* Buttons 10-14 *)
  136.       C+22,                      (* Button shadow 15 *)
  137.       C+16,C+17,C+15,            (* Cluster 16-18 *)
  138.       C+18,C+19,C+20,            (* Input line 19-21 *)
  139.       C+21,C+0,C+23,C+24,        (* History 22-25 *)
  140.       C+27,C+26,C+28,C+25,       (* List viewer 26-29 *)
  141.       C+29,C+30,C+31,            (* Info pane 30, reserved 31-32 *)
  142.  
  143.       (* Help window 128-135 *)
  144.       129,130,133,               (* Frame 128-130 *)
  145.       131,132,                   (* Scrollbar 131-132 *)
  146.       134,128,135                (* Normal, Keyword, Selected 133-135 *)
  147.     );
  148.  
  149.  
  150.   (*******************************************************************
  151.     Palette changer
  152.   *******************************************************************)
  153.   procedure SetPalette(const Pal:TPalette);
  154.   begin
  155.     Application^.GetPalette^:=Pal;
  156.     DoneMemory;
  157.     Application^.Redraw;
  158.   end;
  159.  
  160.  
  161.   (*******************************************************************
  162.     Initialize
  163.   *******************************************************************)
  164.   constructor TColorBox.Init;
  165.     var
  166.       R : TRect;
  167.   begin
  168.     inherited Init(Application^.GetPalette^, AGroups);
  169.     OldPal:=Pal;
  170.  
  171.     AddHelpCtx(@Self, PWord(@ColorSelHelpCtxList));
  172.  
  173.     R.Assign(3, 15, 26, 16);
  174.     New(Propagation, Init(R, NewSItem('~C~olor propagation', Nil)));
  175.     Propagation^.HelpCtx:=hctoyCSPropagation;
  176.     if ColorPropagation then
  177.       Propagation^.Press(0);
  178.     Insert(Propagation);
  179.   end;
  180.  
  181.  
  182.   (*******************************************************************
  183.     Capture color updates
  184.   *******************************************************************)
  185.   procedure TColorBox.HandleEvent;
  186.     var
  187.       i    : Integer;
  188.       Save : TPalette;
  189.   begin
  190.     if (Event.What=evBroadcast) and ((Event.Command=cmColorForegroundChanged)
  191.          or (Event.Command=cmColorBackgroundChanged)) then
  192.     begin
  193.       (* Save current state *)
  194.       Save:=Pal;
  195.       inherited HandleEvent(Event);
  196.  
  197.       if Propagation^.Mark(0) then           (* Propagate *)
  198.         for i:=1 to Length(Save) do          (* Find change *)
  199.           if Save[i]<>Pal[i] then
  200.           begin
  201.             Propagate(i);
  202.             Break;
  203.           end;
  204.  
  205.       SetPalette(Pal);                       (* Instant update *)
  206.     end
  207.     else
  208.     begin
  209.       (* Revert *)
  210.       if (Event.What=evCommand) and (Event.Command=cmCancel) then
  211.         SetPalette(OldPal);
  212.       inherited HandleEvent(Event);
  213.     end;
  214.   end;
  215.  
  216.  
  217.   (*******************************************************************
  218.     Propagate change
  219.   *******************************************************************)
  220.   procedure TColorBox.Propagate;
  221.     var
  222.       i   : Integer;
  223.       Col : Byte;
  224.       P   : array [0..255] of Byte ABSOLUTE Pal;
  225.   begin
  226.     i:=Links[Start];
  227.     Col:=P[Start] and $70;
  228.  
  229.     (* Take care of history button *)
  230.     case Start of
  231.       53,53+32,53+64:
  232.         P[Start+1]:=P[Start+1] and $F0 or Col shr 4;
  233.       54,54+32,54+64:
  234.